home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / Bonus / DBaldwin / htmllite.exe / demo_src / htmled1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-24  |  9.5 KB  |  375 lines

  1.  
  2.  
  3. {
  4.  The purpose of this demo is to illustrate the usage of the new FindDisplayPos,
  5.  FindSourcePos, and DisplayPosToXY methods and SelStart, SelLength properties.
  6.  These new properties and methods relate character positions in the HTML source
  7.  with those in the displayed document.
  8.  
  9.  This demo is a simple two window editor.  Text entry and modifications are made
  10.  in the TRichEdit window but appear immediately in the ThtmlLite window.
  11.  Positions marked in the ThtmlLite window are also hilighted in the TRichEdit
  12.  window.
  13.  
  14.  Since display updates are accomplished by reloading the document, this scheme
  15.  obviously works best with a fast computer and simple documents.
  16.  
  17.  This demo will not run in Delphi 2 as there is no TSplitter
  18. }
  19.  
  20. {$ifdef ver140}  {Delphi 6}
  21. {$warn Symbol_Platform Off}
  22. {$endif}
  23.  
  24. unit HTMLEd1;
  25.  
  26. interface
  27.  
  28. uses
  29.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  30.   ExtCtrls, Menus, HtmlLite, StdCtrls, ComCtrls, ShellAPI;
  31.  
  32. type
  33.   TForm1 = class(TForm)
  34.     Panel1: TPanel;
  35.     Panel2: TPanel;
  36.     MainMenu1: TMainMenu;
  37.     File1: TMenuItem;
  38.     Open1: TMenuItem;
  39.     OpenDialog: TOpenDialog;
  40.     RichEdit: TRichEdit;
  41.     Splitter1: TSplitter;
  42.     New1: TMenuItem;
  43.     Save1: TMenuItem;
  44.     Saveas1: TMenuItem;
  45.     ExitItem: TMenuItem;
  46.     SaveDialog1: TSaveDialog;
  47.     Edit1: TMenuItem;
  48.     Copy1: TMenuItem;
  49.     Cut1: TMenuItem;
  50.     Paste1: TMenuItem;
  51.     N2: TMenuItem;
  52.     Button1: TButton;
  53.     Button2: TButton;
  54.     Button3: TButton;
  55.     Viewer: ThtmlLite;
  56.     procedure Open1Click(Sender: TObject);
  57.     procedure RichEdChange(Sender: TObject);
  58.     procedure FormCreate(Sender: TObject);
  59.     procedure RichEditSelectionChange(Sender: TObject);
  60.     procedure ViewerMouseUp(Sender: TObject; Button: TMouseButton;
  61.       Shift: TShiftState; X, Y: Integer);
  62.     procedure FormShow(Sender: TObject);
  63.     procedure Save1Click(Sender: TObject);
  64.     procedure Saveas1Click(Sender: TObject);
  65.     procedure New1Click(Sender: TObject);
  66.     procedure EditCopy(Sender: TObject);
  67.     procedure EditCut(Sender: TObject);
  68.     procedure EditPaste(Sender: TObject);
  69.     procedure ExitItemClick(Sender: TObject);
  70.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  71.     procedure ButtonClick(Sender: TObject);
  72.     procedure ViewerHotSpotClick(Sender: TObject; const SRC: String;
  73.       var Handled: Boolean);
  74.   private
  75.     { Private declarations }
  76.     ViewerOK, RichOK: boolean;
  77.     procedure CheckFileSave;
  78.     procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  79.   public
  80.     { Public declarations }
  81.     CurrentFile: String;
  82.   end;
  83.  
  84. var
  85.   Form1: TForm1;
  86.  
  87. implementation
  88.  
  89. {$R *.DFM}
  90.  
  91. procedure TForm1.FormCreate(Sender: TObject);
  92. begin
  93. DragAcceptFiles(Handle, True);
  94. RichEdit.Modified := False;
  95. end;
  96.  
  97. procedure TForm1.Open1Click(Sender: TObject);
  98. var
  99.   Stream: TMemoryStream;
  100.   S: string;
  101. begin
  102. CheckFileSave;
  103. if CurrentFile <> '' then
  104.   OpenDialog.InitialDir := ExtractFilePath(CurrentFile)
  105. else OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  106. OpenDialog.FilterIndex := 1;
  107. if OpenDialog.Execute then
  108.   begin
  109.   Stream := TMemoryStream.Create;
  110.   try
  111.     Stream.LoadFromFile(OpenDialog.Filename);
  112.     SetLength(S, Stream.Size);
  113.     Move(Stream.Memory^, S[1], Stream.Size);
  114.     RichEdit.Text := S;
  115.     Viewer.LoadFromBuffer(PChar(S), Stream.Size);
  116.     CurrentFile := OpenDialog.Filename;
  117.     Caption := CurrentFile;
  118.     RichOK := True;
  119.     ViewerOK := True;
  120.     RichEdit.Modified := False;
  121.   finally
  122.     Stream.Free;
  123.     end;
  124.   end;
  125. end;
  126.  
  127. procedure TForm1.Saveas1Click(Sender: TObject);
  128. begin
  129. SaveDialog1.InitialDir := ExtractFilePath(CurrentFile);
  130. SaveDialog1.Filename := ExtractFilename(CurrentFile);
  131. if SaveDialog1.Execute then
  132.   begin
  133.   RichEdit.Lines.SaveToFile(SaveDialog1.FileName);
  134.   CurrentFile := SaveDialog1.FileName;
  135.   Caption := CurrentFile;
  136.   RichEdit.Modified := False;
  137.   end;
  138. end;
  139.  
  140. procedure TForm1.Save1Click(Sender: TObject);
  141. begin
  142. if CurrentFile = '' then
  143.   SaveAs1Click(Sender)
  144. else
  145.   begin
  146.   RichEdit.Lines.SaveToFile(CurrentFile);
  147.   RichEdit.Modified := False;
  148.   end;
  149. end;
  150.  
  151. procedure TForm1.RichEdChange(Sender: TObject);
  152. {TRichEdit OnChange handler}
  153. var
  154.   Position: integer;
  155. begin
  156. if RichOK then  
  157.   begin
  158.   Position := Viewer.Position;
  159.   Viewer.LoadFromBuffer(PChar(RichEdit.Text), Length(RichEdit.Text));
  160.   ViewerOK := True;
  161.   Viewer.Position := Position;
  162.   RichEditSelectionChange(Nil);
  163.   end;
  164. end;
  165.  
  166. procedure TForm1.RichEditSelectionChange(Sender: TObject);
  167. {TRichEdit OnSelectionChange handler}
  168. var
  169.   Pos1, Pos2, X, Y, VPos, SStr, SLen: integer;
  170. begin
  171. if ViewerOK then
  172.   begin
  173.   SStr := RichEdit.SelStart;
  174.   SLen := RichEdit.SelLength;
  175.   if SStr+SLen > Length(RichEdit.Text) then
  176.      SLen := Length(RichEdit.Text)-SStr;
  177.   Pos1 := Viewer.FindDisplayPos(SStr, False);
  178.   if Pos1 < 0 then  {means it's past end}
  179.     Pos1 := Viewer.FindDisplayPos(SStr, True);
  180.   if SLen <> 0 then
  181.     begin
  182.     Pos2 := Viewer.FindDisplayPos(SStr+SLen, False);  
  183.     if Pos2 < 0 then
  184.       Pos2 := Viewer.FindDisplayPos(SStr+SLen-1, False); {fix for above}
  185.     end
  186.   else
  187.     Pos2 := Pos1;
  188.   if (Pos1 >= 0) and Viewer.DisplayPosToXY(Pos1, X, Y) then
  189.     begin
  190.     {see if Viewer is positioned properly}
  191.     VPos := Viewer.VScrollBarPosition;
  192.     if (Y < VPos) or
  193.            (Y > VPos +Viewer.ClientHeight-20) then
  194.       Viewer.VScrollBarPosition := (Y - Viewer.ClientHeight div 2);
  195.     Viewer.SelStart := Pos1;
  196.     Viewer.SelLength := Pos2-Pos1;
  197.     end;
  198.   end;
  199. end;
  200.  
  201. procedure TForm1.ViewerMouseUp(Sender: TObject; Button: TMouseButton;
  202.   Shift: TShiftState; X, Y: Integer);
  203. var
  204.   Pos, Pos2, VSelLength: integer;
  205. begin
  206. if not ViewerOK then Exit;
  207. ViewerOK := False;
  208. try
  209.   VSelLength := Viewer.SelLength;
  210.   if VSelLength >= 0 then
  211.     Pos := Viewer.FindSourcePos(Viewer.SelStart)
  212.   else Pos := Viewer.FindSourcePos(Viewer.SelStart+VSelLength);
  213.   if Pos >= 0 then
  214.     begin
  215.     RichEdit.SelStart := Pos;
  216.     if VSelLength = 0 then
  217.       RichEdit.SelLength := 0
  218.     else if VSelLength > 0 then
  219.       begin
  220.       Pos2 := Viewer.FindSourcePos(Viewer.SelStart+VSelLength-1)+1;
  221.       RichEdit.SelLength := Pos2-Pos;
  222.       end
  223.     else
  224.       begin
  225.       Pos2 := Viewer.FindSourcePos(Viewer.SelStart-1)+1;
  226.       RichEdit.SelLength := Pos2-Pos;
  227.       end;
  228.     RichEdit.SetFocus;
  229.     end;
  230. finally
  231.   ViewerOK := True;
  232.   end;
  233. end;
  234.  
  235. procedure TForm1.New1Click(Sender: TObject);
  236. begin
  237. if RichEdit.Modified then
  238.   SaveAs1Click(Nil);
  239. RichEdit.Text := '';
  240. Viewer.Clear;
  241. ViewerOK := True;
  242. RichOK := True;
  243. if CurrentFile <> '' then
  244.   CurrentFile := ExtractFilePath(CurrentFile)
  245. else CurrentFile := ExtractFilePath(ParamStr(0));
  246. CurrentFile := CurrentFile+'Untitled.htm';
  247. Caption := CurrentFile;
  248. end;
  249.  
  250. procedure TForm1.FormShow(Sender: TObject);
  251. var
  252.   S: string;
  253.   I: integer;
  254. begin
  255. if (ParamCount >= 1) then
  256.   begin            {Parameter is file to load}
  257.   S := CmdLine;         
  258.   I := Pos('" ', S);
  259.   if I > 0 then
  260.     Delete(S, 1, I+1)     {delete EXE name in quotes}
  261.   else Delete(S, 1, Length(ParamStr(0)));  {in case no quote marks}
  262.   I := Pos('"', S);
  263.   while I > 0 do     {remove any quotes from parameter}
  264.     begin
  265.     Delete(S, I, 1);
  266.     I := Pos('"', S);
  267.     end;
  268.   CurrentFile := Trim(S);
  269.   SetCurrentDir(ExtractFilePath(CurrentFile));
  270.   RichEdit.Lines.LoadFromFile(CurrentFile);
  271.   Caption := CurrentFile;
  272.   Viewer.LoadStrings(RichEdit.Lines);
  273.   RichEdit.SetFocus;
  274.   RichOK := True;
  275.   ViewerOK := True;
  276.   RichEdit.Modified := False;
  277.   end
  278. else New1Click(Sender);
  279. end;
  280.  
  281. procedure TForm1.EditCut(Sender: TObject);
  282. begin
  283. RichEdit.CutToClipboard;
  284. end;
  285.  
  286. procedure TForm1.EditCopy(Sender: TObject);
  287. begin
  288. RichEdit.CopyToClipboard;
  289. end;
  290.  
  291. procedure TForm1.EditPaste(Sender: TObject);
  292. begin
  293. RichEdit.PasteFromClipboard;
  294. end;
  295.  
  296. procedure TForm1.CheckFileSave;
  297. var
  298.   SaveResp: Integer;
  299. begin
  300.   if not RichEdit.Modified then Exit;
  301.   SaveResp := MessageDlg(Format('Save changes to %s?', [CurrentFile]),
  302.     mtConfirmation, mbYesNoCancel, 0);
  303.   case SaveResp of
  304.     idYes: Save1Click(Self);
  305.     idNo: {Nothing};
  306.     idCancel: Abort;
  307.   end;
  308. end;
  309.  
  310. procedure TForm1.ExitItemClick(Sender: TObject);
  311. begin
  312. Close;
  313. end;
  314.  
  315. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  316. begin
  317. try
  318.   CheckFileSave;
  319. except
  320.   CanClose := False;
  321.   end;
  322. end;
  323.  
  324. procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
  325. var
  326.   CFileName: array[0..MAX_PATH] of Char;
  327. begin
  328.   try
  329.     if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then
  330.     begin
  331.       CheckFileSave;
  332.       RichEdit.Lines.LoadFromFile(CFileName);
  333.       CurrentFile := CFileName;
  334.       SetCurrentDir(ExtractFilePath(CurrentFile));
  335.       Caption := CurrentFile;
  336.       Viewer.LoadStrings(RichEdit.Lines);
  337.       RichEdit.SetFocus;
  338.       RichOK := True;
  339.       ViewerOK := True;
  340.       RichEdit.Modified := False;
  341.       Msg.Result := 0;
  342.     end;
  343.   finally
  344.     DragFinish(Msg.Drop);
  345.   end;
  346. end;
  347.  
  348. procedure TForm1.ButtonClick(Sender: TObject);
  349. var
  350.   C: char;
  351. begin
  352. case TButton(Sender).Tag of
  353.   0: C := 'B';
  354.   1: C := 'I';
  355.   2: C := 'U';
  356.   else C := 'B';
  357.   end;
  358. with RichEdit do
  359.   begin
  360.   SelText := '<'+C+'>'+SelText+'</'+C+'>';
  361.   SetFocus;
  362.   end;
  363. end;
  364.  
  365. procedure TForm1.ViewerHotSpotClick(Sender: TObject; const SRC: String;
  366.   var Handled: Boolean);
  367. {HotspotClick handler}
  368. begin  {allow only local links to work}
  369. if (Length(SRC) > 0) and (Trim(SRC)[1] = '#') then
  370.   Handled := False
  371. else Handled := True;
  372. end;
  373.  
  374. end.
  375.